ifelse(Q19 == "No understanding", "No understanding - AL",
ifelse(Q19 == "Basic understanding", "Basic Understanding - AL",
ifelse(Q19 == "Good understanding", "Good understanding - AL",
ifelse(Q19 == "Excellent understanding", "Excellent understanding - AL",
ifelse(Q19 == "I have published papers on this topic", "I have published papers on this topic - AL",
ifelse(Q19 == "Other (please state)", "Other (please state) - AL", Q19))))))),
Q26 = ifelse(Q26 == "", "Did not answer - CC",
ifelse(Q26 == "No understanding", "No understanding - CC",
ifelse(Q26 == "Basic understanding", "Basic Understanding - CC",
ifelse(Q26 == "Good understanding", "Good understanding - CC",
ifelse(Q26 == "Excellent understanding", "Excellent understanding - CC",
ifelse(Q26 == "I have published papers on this topic", "I have published papers on this topic - CC",
ifelse(Q26 == "Other (please state)", "Other (please state) - CC", Q26)))))))) %>%
rename(`Animal\nBehaviour` = Q4_1,
`Animal\nCognition` = Q4_2,
`Animal\nLearning` = Q4_3,
`Behavioural\nEcology` = Q4_4,
`Behavioural\nNeuroscience` = Q4_5,
`Comparative\nPsychology` = Q4_6,
Other = Q4_8) %>%
mutate(across(!starts_with("Q"), ~ifelse(. == 1, cur_column(), NA), .names = "top_{.col}")) %>%
unite(col = "Top Domain", starts_with("top_"), sep = "", na.rm = TRUE) %>%
pivot_longer(cols = Q19:Q26, names_to = "Question", values_to = "Rating") %>%
transmute(Rating = haven::as_factor(Rating),
Question = ifelse(Question == "Q19", "Associative Learning", "Comparative Cognition"),
Question = haven::as_factor(Question),
`Top Domain` = ifelse(`Top Domain` == "", "Did not answer", `Top Domain`)) %>%
group_by(Rating, Question, `Top Domain`) %>%
summarise(Count = n()) %>% complete(`Top Domain`, fill = list(Count = 0))
View(combined_prof_domain_df)
combined_prof_domain_df <- FullCompletion %>% dplyr::select(c(Q4_1:Q4_8, Q19, Q26)) %>% mutate(Q4_1 = as.numeric(Q4_1),
Q4_2 = as.numeric(Q4_2),
Q4_3 = as.numeric(Q4_3),
Q4_4 = as.numeric(Q4_4),
Q4_5 = as.numeric(Q4_5),
Q4_6 = as.numeric(Q4_6),
Q4_8 = as.numeric(Q4_8),
Q19 = ifelse(Q19 == "", "Did not answer", Q19),
Q26 = ifelse(Q26 == "", "Did not answer", Q26)) %>%
rename(`Animal\nBehaviour` = Q4_1,
`Animal\nCognition` = Q4_2,
`Animal\nLearning` = Q4_3,
`Behavioural\nEcology` = Q4_4,
`Behavioural\nNeuroscience` = Q4_5,
`Comparative\nPsychology` = Q4_6,
Other = Q4_8) %>%
mutate(across(!starts_with("Q"), ~ifelse(. == 1, cur_column(), NA), .names = "top_{.col}")) %>%
unite(col = "Top Domain", starts_with("top_"), sep = "", na.rm = TRUE) %>%
pivot_longer(cols = Q19:Q26, names_to = "Question", values_to = "Rating") %>%
transmute(Rating = haven::as_factor(Rating),
Question = ifelse(Question == "Q19", "Associative Learning", "Comparative Cognition"),
Question = haven::as_factor(Question),
`Top Domain` = ifelse(`Top Domain` == "", "Did not answer", `Top Domain`)) %>%
group_by(Rating, Question, `Top Domain`) %>%
summarise(Count = n()) %>% complete(`Top Domain`, fill = list(Count = 0))
combined_prof_domain_df$Rating <- factor(combined_prof_domain_df$Rating, levels = c("No understanding", "Basic understanding", "Good understanding", "Excellent understanding", "I have published papers on this topic", "Other (please state)", "Did not answer"))
CombinedProfDomainPlot <- ggplot(combined_prof_domain_df, aes(y = Question, x = Count, fill = Rating)) +
geom_bar(stat = "identity", position = position_stack(reverse = TRUE), width = 0.6) +
facet_wrap(. ~ `Top Domain`) +
scale_fill_manual(values = custom_colour_palette) +
labs(y = "", fill = "") + xlim(0,55) + scale_y_discrete(limits = rev)
CombinedProfDomainPlot
combined_prof_domain_df$Rating <- factor(combined_prof_domain_df$Rating, levels = c("No understanding", "Basic understanding", "Good understanding", "Excellent understanding", "I have published papers on this topic", "Other (please state)", "Did not answer"))
CombinedProfDomainPlot <- ggplot(combined_prof_domain_df, aes(y = Question, x = Count, fill = Rating)) +
geom_bar(stat = "identity", position = position_stack(reverse = TRUE), width = 0.6) +
facet_wrap(. ~ `Top Domain`) +
scale_fill_manual(values = custom_colour_palette) +
labs(y = "", fill = "") + xlim(0,55) + scale_y_discrete(limits = rev)
CombinedProfDomainPlot
View(combined_prof_domain_df)
combined_prof_domain_df <- FullCompletion %>% dplyr::select(c(Q4_1:Q4_8, Q19, Q26)) %>% mutate(Q4_1 = as.numeric(Q4_1),
Q4_2 = as.numeric(Q4_2),
Q4_3 = as.numeric(Q4_3),
Q4_4 = as.numeric(Q4_4),
Q4_5 = as.numeric(Q4_5),
Q4_6 = as.numeric(Q4_6),
Q4_8 = as.numeric(Q4_8),
Q19 = ifelse(Q19 == "", "Did not answer", Q19),
Q26 = ifelse(Q26 == "", "Did not answer", Q26)) %>%
rename(`Animal\nBehaviour` = Q4_1,
`Animal\nCognition` = Q4_2,
`Animal\nLearning` = Q4_3,
`Behavioural\nEcology` = Q4_4,
`Behavioural\nNeuroscience` = Q4_5,
`Comparative\nPsychology` = Q4_6,
Other = Q4_8) %>%
mutate(across(!starts_with("Q"), ~ifelse(. == 1, cur_column(), NA), .names = "top_{.col}")) %>%
unite(col = "Top Domain", starts_with("top_"), sep = "", na.rm = TRUE) %>%
pivot_longer(cols = (Q19, Q26), names_to = "Question", values_to = "Rating") %>%
combined_prof_domain_df <- FullCompletion %>% dplyr::select(c(Q4_1:Q4_8, Q19, Q26)) %>% mutate(Q4_1 = as.numeric(Q4_1),
Q4_2 = as.numeric(Q4_2),
Q4_3 = as.numeric(Q4_3),
Q4_4 = as.numeric(Q4_4),
Q4_5 = as.numeric(Q4_5),
Q4_6 = as.numeric(Q4_6),
Q4_8 = as.numeric(Q4_8),
Q19 = ifelse(Q19 == "", "Did not answer", Q19),
Q26 = ifelse(Q26 == "", "Did not answer", Q26)) %>%
rename(`Animal\nBehaviour` = Q4_1,
`Animal\nCognition` = Q4_2,
`Animal\nLearning` = Q4_3,
`Behavioural\nEcology` = Q4_4,
`Behavioural\nNeuroscience` = Q4_5,
`Comparative\nPsychology` = Q4_6,
Other = Q4_8) %>%
mutate(across(!starts_with("Q"), ~ifelse(. == 1, cur_column(), NA), .names = "top_{.col}")) %>%
unite(col = "Top Domain", starts_with("top_"), sep = "", na.rm = TRUE) %>%
pivot_longer(cols = c(Q19, Q26), names_to = "Question", values_to = "Rating") %>%
transmute(Rating = haven::as_factor(Rating),
Question = ifelse(Question == "Q19", "Associative Learning", "Comparative Cognition"),
Question = haven::as_factor(Question),
`Top Domain` = ifelse(`Top Domain` == "", "Did not answer", `Top Domain`)) %>%
group_by(Rating, Question, `Top Domain`) %>%
summarise(Count = n()) %>% complete(`Top Domain`, fill = list(Count = 0))
combined_prof_domain_df$Rating <- factor(combined_prof_domain_df$Rating, levels = c("No understanding", "Basic understanding", "Good understanding", "Excellent understanding", "I have published papers on this topic", "Other (please state)", "Did not answer"))
combined_prof_domain_df$Rating
CombinedProfDomainPlot <- ggplot(combined_prof_domain_df, aes(y = Question, x = Count, fill = Rating)) +
geom_bar(stat = "identity", position = position_stack(reverse = TRUE), width = 0.6) +
facet_wrap(. ~ `Top Domain`) +
scale_fill_manual(values = custom_colour_palette) +
labs(y = "", fill = "") + xlim(0,220) + scale_y_discrete(limits = rev)
CombinedProfDomainPlot
CombinedProfDomainPlot <- ggplot(combined_prof_domain_df, aes(y = Question, x = Count, fill = Rating)) +
geom_bar(stat = "identity", position = position_stack(reverse = TRUE), width = 0.6) +
facet_wrap(. ~ `Top Domain`) +
scale_fill_manual(values = proficiency_colour_palette) +
labs(y = "", fill = "") + xlim(0,220) + scale_y_discrete(limits = rev)
CombinedProfDomainPlot
CombinedProfDomainPlot <- ggplot(combined_prof_domain_df, aes(y = Question, x = Count, fill = Rating)) +
geom_bar(stat = "identity", position = position_stack(reverse = TRUE), width = 0.6) +
facet_wrap(. ~ `Top Domain`) +
scale_fill_manual(values = proficiency_colour_palette) +
labs(y = "", fill = "") + xlim(0,55) + scale_y_discrete(limits = rev)
CombinedProfDomainPlot
combined_prof_domain_df_proportions <- combined_prof_domain_df %>% ungroup() %>%
group_by(Question, `Top Domain`) %>%
reframe(Rating = Rating,
Proportion = Count/sum(Count))
CombinedProfDomainPropPlot <- ggplot(combined_prof_domain_df_proportions, aes(y = Question, x = Proportion, fill = Rating)) +
geom_bar(stat = "identity", position = position_stack(reverse = TRUE), width = 0.6) +
facet_wrap(. ~ `Top Domain`) +
scale_fill_manual(values = custom_colour_palette) +
labs(y = "", fill = "") + xlim(0,1) + scale_y_discrete(limits = rev) + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))
CombinedProfDomainPropPlot
ggplot(combined_prof_domain_df_proportions, aes(y = Question, x = Proportion, fill = Rating)) +
geom_bar(stat = "identity", position = position_stack(reverse = TRUE), width = 0.6) +
facet_wrap(. ~ `Top Domain`) +
scale_fill_manual(values = proficiency_colour_palette) +
labs(y = "", fill = "") + xlim(0,1) + scale_y_discrete(limits = rev) + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))
plotly::ggplotly(CombinedProfDomainPropPlot)
CombinedProfDomainPropPlot <- ggplot(combined_prof_domain_df_proportions, aes(y = Question, x = Proportion, fill = Rating)) +
geom_bar(stat = "identity", position = position_stack(reverse = TRUE), width = 0.6) +
facet_wrap(. ~ `Top Domain`) +
scale_fill_manual(values = proficiency_colour_palette) +
labs(y = "", fill = "") + xlim(0,1) + scale_y_discrete(limits = rev) + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))
plotly::ggplotly(CombinedProfDomainPropPlot)
combined_concept_EThreat_domain_df <- FullCompletion %>% dplyr::select(c(Q4_1:Q4_8, Q23, Q24, Q30)) %>% mutate(Q4_1 = as.numeric(Q4_1),
Q4_2 = as.numeric(Q4_2),
Q4_3 = as.numeric(Q4_3),
Q4_4 = as.numeric(Q4_4),
Q4_5 = as.numeric(Q4_5),
Q4_6 = as.numeric(Q4_6),
Q4_8 = as.numeric(Q4_8),
across(starts_with("Q2"|"Q3"), ~ifelse(. == "", "Did not answer", .))) %>%
rename(`Animal\nBehaviour` = Q4_1,
`Animal\nCognition` = Q4_2,
`Animal\nLearning` = Q4_3,
`Behavioural\nEcology` = Q4_4,
`Behavioural\nNeuroscience` = Q4_5,
`Comparative\nPsychology` = Q4_6,
Other = Q4_8) %>%
mutate(across(!starts_with("Q"), ~ifelse(. == 1, cur_column(), NA), .names = "top_{.col}")) %>%
unite(col = "Top Domain", starts_with("top_"), sep = "", na.rm = TRUE) %>%
pivot_longer(cols = c(Q23, Q24, Q30), names_to = "Question", values_to = "Rating") %>%
transmute(Rating = haven::as_factor(Rating),
Question = ifelse(Question == "Q23", "Associative learning",
ifelse(Question == "Q24", "Cognition", "Power argument")),
Question = haven::as_factor(Question),
`Top Domain` = ifelse(`Top Domain` == "", "Did not answer", `Top Domain`)) %>%
group_by(Rating, Question, `Top Domain`) %>%
summarise(Count = n()) %>% complete(`Top Domain`, fill = list(Count = 0))
?starts_with
combined_concept_EThreat_domain_df <- FullCompletion %>% dplyr::select(c(Q4_1:Q4_8, Q23, Q24, Q30)) %>% mutate(Q4_1 = as.numeric(Q4_1),
Q4_2 = as.numeric(Q4_2),
Q4_3 = as.numeric(Q4_3),
Q4_4 = as.numeric(Q4_4),
Q4_5 = as.numeric(Q4_5),
Q4_6 = as.numeric(Q4_6),
Q4_8 = as.numeric(Q4_8),
across(matches("Q2"|"Q3"), ~ifelse(. == "", "Did not answer", .))) %>%
rename(`Animal\nBehaviour` = Q4_1,
`Animal\nCognition` = Q4_2,
`Animal\nLearning` = Q4_3,
`Behavioural\nEcology` = Q4_4,
`Behavioural\nNeuroscience` = Q4_5,
`Comparative\nPsychology` = Q4_6,
Other = Q4_8) %>%
mutate(across(!starts_with("Q"), ~ifelse(. == 1, cur_column(), NA), .names = "top_{.col}")) %>%
unite(col = "Top Domain", starts_with("top_"), sep = "", na.rm = TRUE) %>%
pivot_longer(cols = c(Q23, Q24, Q30), names_to = "Question", values_to = "Rating") %>%
transmute(Rating = haven::as_factor(Rating),
Question = ifelse(Question == "Q23", "Associative learning",
ifelse(Question == "Q24", "Cognition", "Power argument")),
Question = haven::as_factor(Question),
`Top Domain` = ifelse(`Top Domain` == "", "Did not answer", `Top Domain`)) %>%
group_by(Rating, Question, `Top Domain`) %>%
summarise(Count = n()) %>% complete(`Top Domain`, fill = list(Count = 0))
combined_concept_EThreat_domain_df <- FullCompletion %>% dplyr::select(c(Q4_1:Q4_8, Q23, Q24, Q30)) %>% mutate(Q4_1 = as.numeric(Q4_1),
Q4_2 = as.numeric(Q4_2),
Q4_3 = as.numeric(Q4_3),
Q4_4 = as.numeric(Q4_4),
Q4_5 = as.numeric(Q4_5),
Q4_6 = as.numeric(Q4_6),
Q4_8 = as.numeric(Q4_8),
across(matches("Q2|Q3"), ~ifelse(. == "", "Did not answer", .))) %>%
rename(`Animal\nBehaviour` = Q4_1,
`Animal\nCognition` = Q4_2,
`Animal\nLearning` = Q4_3,
`Behavioural\nEcology` = Q4_4,
`Behavioural\nNeuroscience` = Q4_5,
`Comparative\nPsychology` = Q4_6,
Other = Q4_8) %>%
mutate(across(!starts_with("Q"), ~ifelse(. == 1, cur_column(), NA), .names = "top_{.col}")) %>%
unite(col = "Top Domain", starts_with("top_"), sep = "", na.rm = TRUE) %>%
pivot_longer(cols = c(Q23, Q24, Q30), names_to = "Question", values_to = "Rating") %>%
transmute(Rating = haven::as_factor(Rating),
Question = ifelse(Question == "Q23", "Associative learning",
ifelse(Question == "Q24", "Cognition", "Power argument")),
Question = haven::as_factor(Question),
`Top Domain` = ifelse(`Top Domain` == "", "Did not answer", `Top Domain`)) %>%
group_by(Rating, Question, `Top Domain`) %>%
summarise(Count = n()) %>% complete(`Top Domain`, fill = list(Count = 0))
View(combined_concept_EThreat_domain_df)
CombinedConceptThreatDomainPlot <- ggplot(combined_concept_EThreat_domain_df, aes(y = Question, x = Count, fill = Rating)) +
geom_bar(stat = "identity", position = position_stack(reverse = TRUE), width = 0.6) +
facet_wrap(. ~ `Top Domain`) +
scale_fill_manual(values = custom_colour_palette) +
labs(y = "", fill = "") + xlim(0,55) + scale_y_discrete(limits = rev)
CombinedConceptThreatDomainPlot
combined_concept_EThreat_domain_df$Rating <- factor(combined_concept_EThreat_domain_df$Rating, levels = c("Strongly disagree", "Disagree", "Neither agree nor disagree", "Agree", "Strongly agree", "Not sure", "Did not answer"))
combined_concept_EThreat_domain_df <- combined_concept_EThreat_domain_df[order(levels(combined_concept_EThreat_domain_df$CogConcept)),]
combined_concept_EThreat_domain_df <- combined_concept_EThreat_domain_df[order(levels(combined_concept_EThreat_domain_df$Rating)),]
CombinedConceptThreatDomainPlot <- ggplot(combined_concept_EThreat_domain_df, aes(y = Question, x = Count, fill = Rating)) +
geom_bar(stat = "identity", position = position_stack(reverse = TRUE), width = 0.6) +
facet_wrap(. ~ `Top Domain`) +
scale_fill_manual(values = custom_colour_palette) +
labs(y = "", fill = "") + xlim(0,55) + scale_y_discrete(limits = rev)
CombinedConceptThreatDomainPlot
combined_concept_EThreat_domain_df$Rating <- factor(combined_concept_EThreat_domain_df$Rating, levels = c("Strongly disagree", "Disagree", "Neither agree nor disagree", "Agree", "Strongly agree", "Not sure", "Did not answer"))
CombinedConceptThreatDomainPlot <- ggplot(combined_concept_EThreat_domain_df, aes(y = Question, x = Count, fill = Rating)) +
geom_bar(stat = "identity", position = position_stack(reverse = TRUE), width = 0.6) +
facet_wrap(. ~ `Top Domain`) +
scale_fill_manual(values = custom_colour_palette) +
labs(y = "", fill = "") + xlim(0,55) + scale_y_discrete(limits = rev)
CombinedConceptThreatDomainPlot
combined_concept_EThreat_domain_df <- FullCompletion %>% dplyr::select(c(Q4_1:Q4_8, Q23, Q24, Q30)) %>% mutate(Q4_1 = as.numeric(Q4_1),
Q4_2 = as.numeric(Q4_2),
Q4_3 = as.numeric(Q4_3),
Q4_4 = as.numeric(Q4_4),
Q4_5 = as.numeric(Q4_5),
Q4_6 = as.numeric(Q4_6),
Q4_8 = as.numeric(Q4_8),
across(matches("Q2|Q3"), ~ifelse(. == "", "Did not answer", .))) %>%
rename(`Animal\nBehaviour` = Q4_1,
`Animal\nCognition` = Q4_2,
`Animal\nLearning` = Q4_3,
`Behavioural\nEcology` = Q4_4,
`Behavioural\nNeuroscience` = Q4_5,
`Comparative\nPsychology` = Q4_6,
Other = Q4_8) %>%
mutate(across(!starts_with("Q"), ~ifelse(. == 1, cur_column(), NA), .names = "top_{.col}")) %>%
unite(col = "Top Domain", starts_with("top_"), sep = "", na.rm = TRUE) %>%
pivot_longer(cols = c(Q23, Q24, Q30), names_to = "Question", values_to = "Rating") %>%
transmute(Rating = haven::as_factor(Rating),
Question = ifelse(Question == "Q23", "Associative learning",
ifelse(Question == "Q24", "Cognition", "Power argument")),
Question = haven::as_factor(Question),
`Top Domain` = ifelse(`Top Domain` == "", "Did not answer", `Top Domain`)) %>%
group_by(Rating, Question, `Top Domain`) %>%
summarise(Count = n()) %>% complete(`Top Domain`, fill = list(Count = 0))
combined_concept_EThreat_domain_df <- combined_concept_EThreat_domain_df[order(levels(combined_concept_EThreat_domain_df$Rating)),]
CombinedConceptThreatDomainPlot <- ggplot(combined_concept_EThreat_domain_df, aes(y = Question, x = Count, fill = Rating)) +
geom_bar(stat = "identity", position = position_stack(reverse = TRUE), width = 0.6) +
facet_wrap(. ~ `Top Domain`) +
scale_fill_manual(values = custom_colour_palette) +
labs(y = "", fill = "") + xlim(0,55) + scale_y_discrete(limits = rev)
plotly::ggplotly(CombinedConceptThreatDomainPlot)
combined_concept_EThreat_domain_df <- FullCompletion %>% dplyr::select(c(Q4_1:Q4_8, Q23, Q24, Q30)) %>% mutate(Q4_1 = as.numeric(Q4_1),
Q4_2 = as.numeric(Q4_2),
Q4_3 = as.numeric(Q4_3),
Q4_4 = as.numeric(Q4_4),
Q4_5 = as.numeric(Q4_5),
Q4_6 = as.numeric(Q4_6),
Q4_8 = as.numeric(Q4_8),
across(matches("Q2|Q3"), ~ifelse(. == "", "Did not answer", .))) %>%
rename(`Animal\nBehaviour` = Q4_1,
`Animal\nCognition` = Q4_2,
`Animal\nLearning` = Q4_3,
`Behavioural\nEcology` = Q4_4,
`Behavioural\nNeuroscience` = Q4_5,
`Comparative\nPsychology` = Q4_6,
Other = Q4_8) %>%
mutate(across(!starts_with("Q"), ~ifelse(. == 1, cur_column(), NA), .names = "top_{.col}")) %>%
unite(col = "Top Domain", starts_with("top_"), sep = "", na.rm = TRUE) %>%
pivot_longer(cols = c(Q23, Q24, Q30), names_to = "Question", values_to = "Rating") %>%
transmute(Rating = haven::as_factor(Rating),
Question = ifelse(Question == "Q23", "Associative learning",
ifelse(Question == "Q24", "Cognition", "Power argument")),
Question = haven::as_factor(Question),
`Top Domain` = ifelse(`Top Domain` == "", "Did not answer", `Top Domain`)) %>%
group_by(Rating, Question, `Top Domain`) %>%
summarise(Count = n()) %>% complete(`Top Domain`, fill = list(Count = 0))
combined_concept_EThreat_domain_df$Rating <- factor(combined_concept_EThreat_domain_df$Rating, levels = c("Strongly disagree", "Disagree", "Neither agree nor disagree", "Agree", "Strongly agree", "Not sure", "Did not answer"))
CombinedConceptThreatDomainPlot <- ggplot(combined_concept_EThreat_domain_df, aes(y = Question, x = Count, fill = Rating)) +
geom_bar(stat = "identity", position = position_stack(reverse = TRUE), width = 0.6) +
facet_wrap(. ~ `Top Domain`) +
scale_fill_manual(values = custom_colour_palette) +
labs(y = "", fill = "") + xlim(0,55) + scale_y_discrete(limits = rev)
CombinedConceptThreatDomainPlot
plotly::ggplotly(CombinedConceptThreatDomainPlot)
combined_concept_EThreat_domain_df_proportions <- combined_concept_EThreat_domain_df %>% ungroup() %>%
group_by(Question, `Top Domain`) %>%
reframe(Rating = Rating,
Proportion = Count/sum(Count))
CombinedConceptThreatDomainPropPlot <- ggplot(combined_concept_EThreat_domain_df_proportions, aes(y = Question, x = Proportion, fill = Rating)) +
geom_bar(stat = "identity", position = position_stack(reverse = TRUE), width = 0.6) +
facet_wrap(. ~ `Top Domain`) +
scale_fill_manual(values = custom_colour_palette) +
labs(y = "", fill = "") + xlim(0,1) + scale_y_discrete(limits = rev) + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))
CombinedConceptThreatDomainPropPlot
citation("tudyverse")
citation("tidyverse")
setwd("~/Library/CloudStorage/OneDrive-HelmholtzZentrumMünchen/Cambridge/MTEC Postdoc/Manuscripts/Survey/JCP/Supplementary Material")
################################################################################
## Inter-rater reliability script
library(irr)
library(tidyverse)
library(haven)
library(readxl)
# a function that takes the dataframes, puts them in long format, and returns Kripp's Alpha and the percentage agreement between raters.
# note that Kripp's Alpha is defined across all category-response pairings, rather than per category.
return_kripps_and_pct_agreement <- function(subset_df, full_df){
if (nrow(subset_df)<nrow(full_df)){
subset_df_long <- subset_df %>% pivot_longer(cols = 2:last_col(), names_to = "Category", values_to = "Categorisation") #unroll the dataframe to have responses, categories, and categorisations in columns
colnames(subset_df_long)[1] <- "Question"
full_df_long <- full_df %>% pivot_longer(cols = 2:last_col(), names_to = "Category", values_to = "Categorisation") #unroll the dataframe to have responses, categories, and categorisations in columns
colnames(full_df_long)[1] <- "Question"
combined_df_long <- inner_join(subset_df_long, full_df_long, by = join_by(Question == Question,
Category == Category), suffix = c(".kv", ".mh")) #join dataframes to have categorisations side-by-side for each response-categorisation pair
combined_matrix <- t(as.matrix(combined_df_long[,3:4])) #convert categorisations to matrix for kripps
krippalpha <- kripp.alpha(combined_matrix) #compute kripps and store
percent_agreement_df <- combined_df_long %>% transmute(agreement = ifelse(Categorisation.kv == Categorisation.mh, 1, 0)) #return dataframe of whether reviewer 1 and 2 agreed (1) or not (0)
percent_agreement <- sum(percent_agreement_df$agreement)/nrow(percent_agreement_df) #compute percentage agreement (summarised not used to avoid rounding error)
size_of_each_group <- full_df_long %>% mutate(Category = haven::as_factor(Category)) %>%
group_by(Category) %>%
summarise(Count = sum(Categorisation)) #return dataframe for sample sizes in each category for reporting in tables
output_list <- list("kripps_alpha" = krippalpha, "pct_agreement" = percent_agreement, "group_sizes" = size_of_each_group) #return list of results
return(output_list)
} else {
cat("Enter the subset dataframe as the first dataframe, and the full dataframe as the second, or name the variables.\n")
}
}
## Krippendorff (2004) suggests that alpha should be 0.8 or above. Where tentative conclusions are still acceptable, alpha should be 0.667 or above at the bare minimum. (2004, p. 241)
# Question 11
q11_subset_kv <- read_xlsx("20PerCentSubsetForIRR.xlsx", sheet = "Q11") %>%
mutate(across(everything(), ~ifelse(is.na(.x), 0, ifelse(.x == "X", 1, .x)))) #%>%
#dplyr::select(!1)
q11_full_mh <- read_xlsx("Full Question Categorisations.xlsx",
sheet = "Question 11 - FINAL") #%>% dplyr::select(!1)
Q11_IRR <- return_kripps_and_pct_agreement(q11_subset_kv, q11_full_mh)
# Question 13
Q13_subset_mh <- read_xlsx("20PerCentSubsetForIRR.xlsx", sheet = "Q12_13") %>%
mutate(across(everything(), ~ifelse(is.na(.x), 0, ifelse(.x == "X", 1, .x)))) %>% dplyr::select(!1)
Q13_full_kv <- read_xlsx("Full Question Categorisations.xlsx",
sheet = "Question 12 and 13 - FINAL") %>% dplyr::select(!1) #Q12_13
Q13_IRR <- return_kripps_and_pct_agreement(Q13_subset_mh, Q13_full_kv)
# Question 18
Q18_subset_mh <- read_xlsx("20PerCentSubsetForIRR.xlsx", sheet = "Q18")%>%
mutate(across(everything(), ~ifelse(is.na(.x), 0, ifelse(.x == "X", 1, .x))))
Q18_full_kv <- read_xlsx("Full Question Categorisations.xlsx",
sheet = "Question 18 - FINAL") #Q18
Q18_IRR <- return_kripps_and_pct_agreement(Q18_subset_mh, Q18_full_kv)
# Question 20
Q20_subset_mh <- read_xlsx("20PerCentSubsetForIRR.xlsx", sheet = "Q20") %>%
mutate(across(everything(), ~ifelse(is.na(.x), 0, ifelse(.x == "X", 1, .x))))
Q20_full_kv <- read_xlsx("Full Question Categorisations.xlsx",
sheet = "Question 20 - FINAL") #Q20
Q20_IRR <- return_kripps_and_pct_agreement(Q20_subset_mh, Q20_full_kv)
# # Question 22 #commented out as not reported
#
# Q22_subset_mh <- read_xlsx("20PerCentSubsetForIRR.xlsx", sheet = "Q22") %>%
#   mutate(across(everything(), ~ifelse(is.na(.x), 0, ifelse(.x == "X", 1, .x)))) %>% dplyr::select(!`Remaining will be included in a word cloud/word freq plot`)
#
# Q22_full_kv <- read_xlsx("Full Question Categorisations.xlsx",
#                             sheet = "Question 22 - FINAL") %>% dplyr::select(!`Remaining will be included in a word cloud/word freq plot`) #Q22
#
# Q22_IRR <- return_kripps_and_pct_agreement(Q22_subset_mh, Q22_full_kv)
# Question 25
Q25_subset_mh <- read_xlsx("20PerCentSubsetForIRR.xlsx", sheet = "Q25") %>%
mutate(across(everything(), ~ifelse(is.na(.x), 0, ifelse(.x == "X", 1, .x))))
Q25_full_kv <- read_xlsx("Full Question Categorisations.xlsx",
sheet = "Question 25 - FINAL") #Q25
Q25_IRR <- return_kripps_and_pct_agreement(Q25_subset_mh, Q25_full_kv)
# Question 27
Q27_subset_mh <- read_xlsx("20PerCentSubsetForIRR.xlsx", sheet = "Q27")  %>%
mutate(across(everything(), ~ifelse(is.na(.x), 0, ifelse(.x == "X", 1, .x))))
Q27_full_kv <- read_xlsx("Full Question Categorisations.xlsx",
sheet = "Question 27 - FINAL") #Q27
Q27_IRR <- return_kripps_and_pct_agreement(Q27_subset_mh, Q27_full_kv)
# Question 29 #commented out as not reported
# Q29_subset_mh <- read_xlsx("20PerCentSubsetForIRR.xlsx", sheet = "Q29") %>%
#   mutate(across(everything(), ~ifelse(is.na(.x), 0, ifelse(.x == "X", 1, .x)))) %>% dplyr::select(!`Remaining will be included in a word cloud/word freq plot`)
#
# Q29_full_kv <- read_xlsx("Full Question Categorisations.xlsx",
#                             sheet = "Question 29 - FINAL") %>% dplyr::select(!`Remaining will be included in a word cloud/word freq plot`) #Q29
#
# Q29_IRR <- return_kripps_and_pct_agreement(Q29_subset_mh, Q29_full_kv)
# Question 31
Q31_subset_mh <- read_xlsx("20PerCentSubsetForIRR.xlsx", sheet = "Q31") %>%
mutate(across(everything(), ~ifelse(is.na(.x), 0, ifelse(.x == "X", 1, .x))))
Q31_full_kv <- read_xlsx("Full Question Categorisations.xlsx",
sheet = "Question 31 - FINAL") #Q31
Q31_IRR <- return_kripps_and_pct_agreement(Q31_subset_mh, Q31_full_kv)
################################################################################
## Inter-rater reliability script
library(irr)
library(tidyverse)
library(readxl)
# a function that takes the dataframes, puts them in long format, and returns Kripp's Alpha and the percentage agreement between raters.
# note that Kripp's Alpha is defined across all category-response pairings, rather than per category.
return_kripps_and_pct_agreement <- function(subset_df, full_df){
if (nrow(subset_df)<nrow(full_df)){
subset_df_long <- subset_df %>% pivot_longer(cols = 2:last_col(), names_to = "Category", values_to = "Categorisation") #unroll the dataframe to have responses, categories, and categorisations in columns
colnames(subset_df_long)[1] <- "Question"
full_df_long <- full_df %>% pivot_longer(cols = 2:last_col(), names_to = "Category", values_to = "Categorisation") #unroll the dataframe to have responses, categories, and categorisations in columns
colnames(full_df_long)[1] <- "Question"
combined_df_long <- inner_join(subset_df_long, full_df_long, by = join_by(Question == Question,
Category == Category), suffix = c(".kv", ".mh")) #join dataframes to have categorisations side-by-side for each response-categorisation pair
combined_matrix <- t(as.matrix(combined_df_long[,3:4])) #convert categorisations to matrix for kripps
krippalpha <- kripp.alpha(combined_matrix) #compute kripps and store
percent_agreement_df <- combined_df_long %>% transmute(agreement = ifelse(Categorisation.kv == Categorisation.mh, 1, 0)) #return dataframe of whether reviewer 1 and 2 agreed (1) or not (0)
percent_agreement <- sum(percent_agreement_df$agreement)/nrow(percent_agreement_df) #compute percentage agreement (summarised not used to avoid rounding error)
size_of_each_group <- full_df_long %>% mutate(Category = as_factor(Category)) %>%
group_by(Category) %>%
summarise(Count = sum(Categorisation)) #return dataframe for sample sizes in each category for reporting in tables
output_list <- list("kripps_alpha" = krippalpha, "pct_agreement" = percent_agreement, "group_sizes" = size_of_each_group) #return list of results
return(output_list)
} else {
cat("Enter the subset dataframe as the first dataframe, and the full dataframe as the second, or name the variables.\n")
}
}
## Krippendorff (2004) suggests that alpha should be 0.8 or above. Where tentative conclusions are still acceptable, alpha should be 0.667 or above at the bare minimum. (2004, p. 241)
# Question 11
q11_subset_kv <- read_xlsx("20PerCentSubsetForIRR.xlsx", sheet = "Q11") %>%
mutate(across(everything(), ~ifelse(is.na(.x), 0, ifelse(.x == "X", 1, .x)))) #%>%
#dplyr::select(!1)
q11_full_mh <- read_xlsx("Full Question Categorisations.xlsx",
sheet = "Question 11 - FINAL") #%>% dplyr::select(!1)
Q11_IRR <- return_kripps_and_pct_agreement(q11_subset_kv, q11_full_mh)
# Question 13
Q13_subset_mh <- read_xlsx("20PerCentSubsetForIRR.xlsx", sheet = "Q12_13") %>%
mutate(across(everything(), ~ifelse(is.na(.x), 0, ifelse(.x == "X", 1, .x)))) %>% dplyr::select(!1)
Q13_full_kv <- read_xlsx("Full Question Categorisations.xlsx",
sheet = "Question 12 and 13 - FINAL") %>% dplyr::select(!1) #Q12_13
Q13_IRR <- return_kripps_and_pct_agreement(Q13_subset_mh, Q13_full_kv)
# Question 18
Q18_subset_mh <- read_xlsx("20PerCentSubsetForIRR.xlsx", sheet = "Q18")%>%
mutate(across(everything(), ~ifelse(is.na(.x), 0, ifelse(.x == "X", 1, .x))))
Q18_full_kv <- read_xlsx("Full Question Categorisations.xlsx",
sheet = "Question 18 - FINAL") #Q18
Q18_IRR <- return_kripps_and_pct_agreement(Q18_subset_mh, Q18_full_kv)
# Question 20
Q20_subset_mh <- read_xlsx("20PerCentSubsetForIRR.xlsx", sheet = "Q20") %>%
mutate(across(everything(), ~ifelse(is.na(.x), 0, ifelse(.x == "X", 1, .x))))
Q20_full_kv <- read_xlsx("Full Question Categorisations.xlsx",
sheet = "Question 20 - FINAL") #Q20
Q20_IRR <- return_kripps_and_pct_agreement(Q20_subset_mh, Q20_full_kv)
# # Question 22 #commented out as not reported
#
# Q22_subset_mh <- read_xlsx("20PerCentSubsetForIRR.xlsx", sheet = "Q22") %>%
#   mutate(across(everything(), ~ifelse(is.na(.x), 0, ifelse(.x == "X", 1, .x)))) %>% dplyr::select(!`Remaining will be included in a word cloud/word freq plot`)
#
# Q22_full_kv <- read_xlsx("Full Question Categorisations.xlsx",
#                             sheet = "Question 22 - FINAL") %>% dplyr::select(!`Remaining will be included in a word cloud/word freq plot`) #Q22
#
# Q22_IRR <- return_kripps_and_pct_agreement(Q22_subset_mh, Q22_full_kv)
# Question 25
Q25_subset_mh <- read_xlsx("20PerCentSubsetForIRR.xlsx", sheet = "Q25") %>%
mutate(across(everything(), ~ifelse(is.na(.x), 0, ifelse(.x == "X", 1, .x))))
Q25_full_kv <- read_xlsx("Full Question Categorisations.xlsx",
sheet = "Question 25 - FINAL") #Q25
Q25_IRR <- return_kripps_and_pct_agreement(Q25_subset_mh, Q25_full_kv)
# Question 27
Q27_subset_mh <- read_xlsx("20PerCentSubsetForIRR.xlsx", sheet = "Q27")  %>%
mutate(across(everything(), ~ifelse(is.na(.x), 0, ifelse(.x == "X", 1, .x))))
Q27_full_kv <- read_xlsx("Full Question Categorisations.xlsx",
sheet = "Question 27 - FINAL") #Q27
Q27_IRR <- return_kripps_and_pct_agreement(Q27_subset_mh, Q27_full_kv)
# Question 29 #commented out as not reported
# Q29_subset_mh <- read_xlsx("20PerCentSubsetForIRR.xlsx", sheet = "Q29") %>%
#   mutate(across(everything(), ~ifelse(is.na(.x), 0, ifelse(.x == "X", 1, .x)))) %>% dplyr::select(!`Remaining will be included in a word cloud/word freq plot`)
#
# Q29_full_kv <- read_xlsx("Full Question Categorisations.xlsx",
#                             sheet = "Question 29 - FINAL") %>% dplyr::select(!`Remaining will be included in a word cloud/word freq plot`) #Q29
#
# Q29_IRR <- return_kripps_and_pct_agreement(Q29_subset_mh, Q29_full_kv)
# Question 31
Q31_subset_mh <- read_xlsx("20PerCentSubsetForIRR.xlsx", sheet = "Q31") %>%
mutate(across(everything(), ~ifelse(is.na(.x), 0, ifelse(.x == "X", 1, .x))))
Q31_full_kv <- read_xlsx("Full Question Categorisations.xlsx",
sheet = "Question 31 - FINAL") #Q31
Q31_IRR <- return_kripps_and_pct_agreement(Q31_subset_mh, Q31_full_kv)
